home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_gen / t4diblib.zip / ANIMATE4.F4_ / ANIMATE4.F4
Text File  |  1995-12-11  |  4KB  |  135 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    Caption         =   "ANIMATE4"
  6.    ClientHeight    =   1896
  7.    ClientLeft      =   2628
  8.    ClientTop       =   2688
  9.    ClientWidth     =   2988
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   7.8
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   2316
  21.    Left            =   2580
  22.    LinkTopic       =   "Form1"
  23.    ScaleHeight     =   1896
  24.    ScaleWidth      =   2988
  25.    Top             =   2316
  26.    Width           =   3084
  27.    Begin VBX.T4DILIB dilib2 
  28.       Caption         =   "dilib2"
  29.       ControlMode     =   1  'Lib -> DIB
  30.       Height          =   384
  31.       Left            =   1680
  32.       Top             =   720
  33.       Visible         =   0   'False
  34.       Width           =   972
  35.    End
  36.    Begin VBX.T4DILIB dilib3 
  37.       Caption         =   "dilib3"
  38.       ControlMode     =   3  'DIB -> PIC
  39.       Height          =   372
  40.       Left            =   1680
  41.       Top             =   1200
  42.       Visible         =   0   'False
  43.       Width           =   972
  44.    End
  45.    Begin VB.CommandButton Command1 
  46.       Appearance      =   0  'Flat
  47.       BackColor       =   &H80000005&
  48.       Caption         =   "&Quit"
  49.       Height          =   372
  50.       Left            =   120
  51.       TabIndex        =   0
  52.       Top             =   1200
  53.       Width           =   1452
  54.    End
  55.    Begin VB.Image Image1 
  56.       Appearance      =   0  'Flat
  57.       Height          =   372
  58.       Left            =   120
  59.       Stretch         =   -1  'True
  60.       Top             =   120
  61.       Width           =   372
  62.    End
  63. End
  64. Attribute VB_Name = "Form1"
  65. Attribute VB_Creatable = False
  66. Attribute VB_Exposed = False
  67. Option Explicit
  68. Private Declare Function GlobalFree% Lib "kernel" (ByVal h%)
  69. Private Declare Function GetFreeSpace& Lib "kernel" (ByVal x%)
  70. Dim TimeIn!
  71. Dim Frames%
  72.  
  73. Private Sub Command1_Click()
  74.  Terminate
  75. End Sub
  76.  
  77. Private Sub Form_Load()
  78. Dim loopctr%, memctr%
  79. Dim imwidth!, imheight!, imhwratio!
  80. Dim memret%, hDib%
  81.  Top = (Screen.Height - Height) / 2!
  82.  Left = (Screen.Width - Width) / 2!
  83.  dilib2.LibraryName = "bluespin.ilb"
  84.  dilib2.Action = IM_ACTION_OPENLIBRARY
  85.  Show
  86.  hDib = 0 'Safety pays
  87.  Frames = 0
  88.  TimeIn = Timer
  89.  For loopctr = 1 To 100
  90.   For memctr = 1 To dilib2.MemberCount
  91.    'Disregard these comments for tutorial.
  92.    'Moving image
  93.    'image1.Left = image1.Left + screen.TwipsPerPixelX
  94.    'image1.Top = image1.Top + screen.TwipsPerPixelY
  95.    dilib2.MemberNumber = memctr
  96.    imwidth = dilib2.PixelWidth
  97.    imheight = dilib2.PixelHeight
  98.    imhwratio = imheight / imwidth
  99.    image1.Height = imhwratio * image1.Width
  100. 'If we have an hDib from a previous call, free it.
  101.    If hDib <> 0 Then
  102.     memret = GlobalFree(hDib)
  103.    End If
  104. 'Get the DIB from the library
  105.    dilib2.Action = IM_ACTION_GETMEMBER
  106. 'Save the hDib for freeing later.
  107.    hDib = dilib2.hDib
  108. 'Send the hDib to dilib3 for transformation.
  109.    dilib3.hDib = hDib
  110. 'Put the PIC in image1.
  111.    image1.Picture = dilib3.Picture
  112.    image1.Refresh
  113.    Frames = Frames + 1
  114.   Next memctr
  115.   DoEvents
  116.  Next loopctr
  117.  Terminate
  118. End Sub
  119.  
  120. Private Sub Form_Unload(Cancel As Integer)
  121.  End
  122. End Sub
  123.  
  124. Private Sub Terminate()
  125. Dim TimeOut!, TimeElapsed!, fps!
  126.  TimeOut = Timer
  127.  TimeElapsed = TimeOut - TimeIn
  128.  fps = Frames
  129.  fps = Frames / TimeElapsed
  130.  MsgBox Trim$(Str$(fps)) + " frames per second."
  131.  End
  132. End Sub
  133.  
  134.  
  135.